\version "2.14.0"  % necessary for upgrading to future LilyPond versions.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% TOGGLE FOR POINT-AND-CLICK DEBUGGER (default is 'off')

  \pointAndClickOff
% \pointAndCLickOn

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% PREPARATORY SPECIAL FORMAT SETTINGS

  %% \z: Forces a line break in the score
  %% - defined to resemble Gregorio markup for forced line breaks
  %% - this is perhaps better used in the antiphon lyrics rather than the
  %%   melody line(s).

  z = { \bar "" \break }

 %%% TEXT POINTERS
  %% - acute accents, grave accents, and flexes
  %% - always appear above the note

  acute = ^\markup { \fontsize #6 "´" }
  grave = ^\markup { \fontsize #6 "`" }
  flex  = {
    \override Score.RehearsalMark #'break-align-symbols = #'(BarLine)
    \mark "†"
  }
  mediant = { \mark \markup{\null \raise #0.5 "*"}}
  quilisma = {
    \once \override NoteHead #'stencil = #ly:text-interface::print
    \once \override NoteHead #'text = \markup {
      \musicglyph #"scripts.prall"
    }
  }
  quilismaAlt = {
    \once \override NoteHead #'style = #'vaticana.quilisma
    \once \override NoteHead #'font-size = #5.5
  }

 %%% RECITATION NOTES
  %% - add \recit before the note in question
  %% - does not affect spacing — only appearance

  recit = {
    \once \override NoteHead #'stencil = #ly:text-interface::print
    \once \override NoteHead #'text = \markup \musicglyph #"noteheads.sM1"
  }

 %%% CANTUS FIRMUS LABEL
  %% Place \cf immediately after the first note of the cantus firmus tone
  cf = -\markup { \halign #1.19 \fontsize #-2 \italic "c.f." }

 %%% SQUARE BRACKETS
  %% - left and right brackets spanning an entire staff
  %%   (not an entire system)

  #(define-markup-command (left-bracket layout props) ()
  "Draw left hand bracket"
  (let* ((th 0.1) ;; todo: take from GROB
    (width (* 3.5 th)) ;; todo: take from GROB
    (ext '(-2.8 . 2.8))) ;; todo: take line-count into account
    (ly:bracket Y ext th width)))

  leftBracket = {
    \once \override BreathingSign #'text = #(make-left-bracket-markup)
    \once \override BreathingSign #'break-visibility = #end-of-line-invisible
    \once \override BreathingSign #'Y-offset = ##f
    % Trick to print it after barlines and signatures:
    \once \override BreathingSign #'break-align-symbol = #'custos
    \breathe
  }

  #(define-markup-command (right-bracket layout props) ()
  "Draw right hand bracket"
  (let* ((th 0.1);;todo: take from GROB
    (width (* 3.5 th)) ;; todo: take from GROB
	(ext '(-2.8 . 2.8))) ;; todo: take line-count into account
	(ly:bracket Y ext th (- width))))

  rightBracket = {
    \once \override BreathingSign #'text = #(make-right-bracket-markup)
    \once \override BreathingSign #'Y-offset = ##f
    \once \override BreathingSign #'extra-spacing-width = #'(0 . 2.5)
    \breathe
  }

  %%% CHANT BREAKS
  %% - these are better employed in the melody line(s) than the lyrics.

  
  virgula = {
    \once \override BreathingSign  #'text = #(make-musicglyph-markup "scripts.rcomma")
    \once \override BreathingSign  #'font-size = #-2

    % Workaround: add padding.  Correct fix would be spacing engine handle this.
    \once \override BreathingSign  #'extra-X-extent = #'(-1.0 . 0)

    \breathe
  }
  caesura = {
    \once \override BreathingSign  #'text = #(make-musicglyph-markup "scripts.rvarcomma")
    \once \override BreathingSign  #'font-size = #-2

    % Workaround: add padding.  Correct fix would be spacing engine handle this.
    \once \override BreathingSign  #'extra-X-extent = #'(-1.0 . 0)

    \breathe
  }
  
  %% \divisioMinima: chant-notation quarter-bar

  divisioMinima = {
    \once \override BreathingSign  #'stencil = #ly:breathing-sign::divisio-minima
    \breathe \bar "" % '\bar ""' is a spacing hack to separate from the next note
  }

  %% \divisioMaior: chant-notation half-bar

  divisioMaior = {
    \once \override BreathingSign  #'stencil = #ly:breathing-sign::divisio-maior
    \once \override BreathingSign  #'Y-offset = #0
    \breathe \bar "" % '\bar ""' is a spacing hack to separate from the next note
  }

  %% \divisioMaxima: chant-notation full bar
  divisioMaxima = {
    \once \override Score.RehearsalMark #'padding = #0
    \once \override Score.BarLine #'space-alist =
        #'((time-signature extra-space . 0.75)
           (custos minimum-space . 2.0)
           (clef minimum-space . 1.0)
           (key-signature extra-space . 1.0)
           (key-cancellation extra-space . 1.0)
           (first-note fixed-space . 1.3)
           (next-note semi-fixed-space . 3)
           (right-edge extra-space . 0.0))
    \bar "|"
    %\once \override BreathingSign  #'stencil = #ly:breathing-sign::divisio-maxima
    %\once \override BreathingSign  #'Y-offset = #0
    %\breathe \bar "" % '\bar ""' is a spacing hack to separate from the next note
  }
  
  %% \finalis: chant-notation double bar

  finalis = {
    \once \override Score.BarLine #'space-alist =
        #'((time-signature extra-space . 0.75)
           (custos minimum-space . 2.0)
           (clef minimum-space . 1.0)
           (key-signature extra-space . 1.0)
           (key-cancellation extra-space . 1.0)
           (first-note fixed-space . 1.3)
           (next-note semi-fixed-space . 3)
           (right-edge extra-space . 0.0))
    \bar "||"
    %\once \override BreathingSign  #'stencil = #ly:breathing-sign::finalis
    %\once \override BreathingSign  #'Y-offset = #0
    %\breathe % it is assumed that the finalis will always end a piece of notation and that no note will follow; therefor there is no '\bar ""' here
  }

 %%% MODE/KEY
  %% - May be turned into a dropdown/radio button menu on the Web app
  %% - Feel free to adjust the keys below to desired specifications
  %% - N.B. The Lilypond code must conform to the modes/keys specified
  %%        here; transpositions may be specified elsewhere.

  modeI    = \key d \dorian
  modeII   = \key e \dorian
  modeIII  = \key d \phrygian
  modeIV   = \key d \phrygian
  modeV    = \key c \lydian
  modeVI   = \key f \lydian
  modeVII  = \key d \mixolydian
  modeVIII = \key f \mixolydian
  
  forceHyphen = { \once \override LyricHyphen #'minimum-distance = #0.7 }
  forceItalic = { \override LyricText #'font-shape = #'italic }
  noItalic = { \override LyricText #'font-shape = #'upright }
  slurHide = { \override Slur #'transparent = ##t }
  tieHide = { \override Tie #'transparent = ##t }
  slurShow = { \override Slur #'transparent = ##f }
  tieShow = { \override Tie #'transparent = ##f }
  ignore = { \set ignoreMelismata = ##t }
  ignoreSlurs = { \set ignoreMelismata = ##t }
  follow = { \set ignoreMelismata = ##f }
  followSlurs = { \set ignoreMelismata = ##f }
  doubleSlur = { \once \set doubleSlurs = ##t }


#(define (splitUp chars pred)
       (define (helper chars pred lists)
         (if (null? chars) lists
             (let* (
                    (firstc (car chars))
                    (newlists (helper (cdr chars) pred lists))
                    (firstlist (car newlists)))
                   (if (or (null? firstlist)
                           (eq? (pred firstc) (pred (car firstlist))))
                       (cons (cons firstc firstlist) (cdr newlists))
                       (cons (list firstc) newlists))
              )
           ))
        (helper chars pred (list '()) )
)
           
#(define-markup-command (fakeCaps layout props str) (markup?)
 "Fake small-caps by turning (sequences of) lower-case letters into upper-case and changing the fontsize"
      (let*
           ((chars (string->list str))
            (lists (splitUp chars 
                (lambda (x) (and
                    (< (char->integer x) 128) 
                    (char-lower-case? x) ))))
            (strings (map
                       (lambda (s)
                               (if (char-lower-case? (car s))
                                   (markup #:fontsize -2 (list->string (map char-upcase s)))
                                   (list->string s) ) )
                       lists))
           (mu (markup #:override '(word-space . 0) (make-line-markup strings))) )
          (interpret-markup layout props mu)) )
 
%% UTF-8 utilities
#(define (list->utf-8 l) (apply string-append (map ly:wide-char->utf-8 l)))
           
#(define (utf-8->list str)
    (define (numBytes leader)
            (cond ((< leader #x80) 1)
                  ((< leader #xc0) (begin (stderr "programming-error: bad utf-8:~x\n" leader) 1))
                  ((< leader #xe0) 2)
                  ((< leader #xf0) 3)
                  ((< leader #xf8) 4)
                  (else (begin (stderr "programming-error: utf-8 too big:~x\n" leader) 1))))
     (define (helper start l n)
             (if (= n 0) start
                 (helper (+ (* start #x40) (modulo (car l) #x40)) (cdr l) (- n 1))))
     (define (utf-8->int l)
              (let* ((leader (car l))
                     (n (- (numBytes leader) 1))
                     (fac (/ #x80 (expt 2 n)))
                     (rest (cdr l))
                     (result (helper (modulo leader fac) rest n)))
                    result))
     (define (toListHelper lst chars)
                 (if (null? lst) (reverse chars)
                     (let* ((c (utf-8->int lst))
                            (n (numBytes (car lst)))
                            (t (list-tail lst n))
                            (newC (cons c chars)))
                        (toListHelper t newC))))
    (toListHelper (map char->integer (string->list str)) '() ))

%These are appropriate for Junicode, and other fonts.  Override as necessary
oldStyleZeroCode = ##xF730
smallCapsACode = ##xF761

%For Linux Libertine
oldStyleZeroCodeLL = ##xE01A
smallCapsACodeLL = ##xE051

#(define (change-char-helper aa test? offset)
    (if (string? aa) 
        (let* ((chars (string->list aa))
               (tosc (map (lambda (c)
                               (if (and (<= (char->integer c) 127) (test? c))
                                   (ly:wide-char->utf-8 (+ (char->integer c) offset))
                                   (string c) ) )
                           chars))
                (newStr (apply string-append tosc)))
             newStr)
         aa)
)

#(define (change-char-helper aa test? offset)
    (if (string? aa) 
        (let* ((chars (utf-8->list aa))
               (tosc (map (lambda (c)
                               (if (and (<= c 127) (test? (integer->char c)))
                                   (ly:wide-char->utf-8 (+ c offset))
                                   (if (and (not (eq? test? char-numeric?)) (and (<= c 255) (>= c 224)))
                                       (ly:wide-char->utf-8 (+ c offset))
                                       (if (= c #x0153)
                                           (ly:wide-char->utf-8 #xF6FA)
                                           (ly:wide-char->utf-8 c) ) ) ) )
                           chars))
                (newStr (apply string-append tosc)))
             newStr)
         aa)
)

#(define (to-old-style str) (change-char-helper str char-numeric?
                                (- oldStyleZeroCode (char->integer #\0))))
                                
#(define (to-small-caps str) (change-char-helper str char-lower-case?
                                (- smallCapsACode (char->integer #\a))))

#(define-markup-command (realCaps layout props str) (markup?)
    "Real small capitals"
    (interpret-markup layout props (to-small-caps str)))
    
#(define-markup-command (oldStyleNum layout props str) (markup?)
    "Old-style numerals"
    (interpret-markup layout props (to-old-style str)))

#(define-markup-command (oldStylePageNum layout props str) (markup?)
    "Old-style Page numbers"
    (interpret-markup layout props (to-old-style (number->string (chain-assoc-get 'page:page-number props -1)))))
    
#(define-markup-command (smallCapsOldStyle layout props str) (markup?)
    "Real small caps and old-style numerals"
    (interpret-markup layout props (to-old-style (to-small-caps str))))
    
#(define-markup-command (concat layout props markups) (markup-list?)
    "Concatenate markups with no spaces"
    (interpret-markup layout (cons '((word-space . 0)) props) 
            (make-line-markup markups)))
%%%
#(define-public (bar-number-print grob)
  "Print function for making oldStyle numbers.  Useful for BarNumber, for example"
  (let*
      ((text (ly:grob-property grob 'text))
       (layout (ly:grob-layout grob))
       (defs (ly:output-def-lookup layout 'text-font-defaults))
       (props (ly:grob-alist-chain grob defs)))

    (ly:text-interface::interpret-markup layout
					 props
					 (if (string? text)
					     (markup #:oldStyleNum text)
					     text))))
              
%%%
% Utilities for Baskerville 1757 ligatures
% like string-split, but with a substring rather than a char
#(define (string-split-sub str sub)
        (let* ((idx (string-contains str sub)))
              (if idx
                  (let* ((len1 (string-length sub))
                         (first (substring str 0 idx))
                         (rest (substring str (+ idx len1)))
                         (lrest (string-split-sub rest sub)))
                       (cons first lrest))
                  (list str)
)))

% takes a string, returns a list
#(define (replace-subs str from to)
         (if (string? str)
             (list-join (string-split-sub str from) to)
             (list str)))
               
%list -> list
#(define (replace-subr strings subs . rest)
        (let* ((fn (if(null? rest) (lambda (x) x) (car rest) )))
            (if (null? subs)
                strings
                (replace-subr (apply append (map
                          (lambda (str) (replace-subs str (car subs) (fn (cadr subs)) ))
                          strings ))
                    (cddr subs) fn))))

#(define (make-lig-list str . rest)
        (apply replace-subr (cons (list str) (cons (list "ffi" "ﬃ" "ffl" "ﬄ" "fi" "ﬁ" "fl" "ﬂ" "ff" "ﬀ" ) rest))))
       
#(define (make-blig-markup-fn ligFont)
        (lambda (s)
        (define (imagstep x) (* (log x) (/ 6 (log 2))))
        (let ((step (imagstep (/ 11 12))))
            (markup #:fontsize step #:override `(font-name . ,ligFont) s))))

#(define (make-bv-lig-list ligFont str)
        (apply replace-subr (cons (list str) (cons (list "ﬃ" "I" "ﬄ" "L" "ﬁ" "i" "ﬂ" "l" "ﬀ" "f" ) (list
                    (make-blig-markup-fn ligFont ))))))
                   
#(define (make-bv-hlig-list ligFont l)
        (apply replace-subr (cons l (cons (list "ct" "C" "st" "S" ) (list
                    (make-blig-markup-fn ligFont) )))))

#(define (add-ligs str)
        (apply string-append (make-lig-list str)))

       
doHlig = ##t

#(define-markup-command (addBLigs layout props str) (markup?) 
        "Add Baskerville 1757 ligatures, including st and ct, to a string"
        (let* ((str1 (add-ligs str))
               (shape (chain-assoc-get 'font-shape props #f))
               (isItalic (eqv? shape 'italic))
               (ligFont (if isItalic "Baskerville1757Ligatures Italic" "Baskerville1757Ligatures"))
               (markups1 (make-bv-lig-list ligFont str1))
               (markups (if doHlig (make-bv-hlig-list ligFont markups1) markups1))
               (result (markup #:override '(word-space . 0) (make-line-markup markups ))))
       (interpret-markup layout props result)))
       
#(define-markup-list-command (addBLigsList layout props strings) (markup-list?) 
        "Add Baskerville 1757 ligatures, including st and ct, to a list of strings"
        (interpret-markup-list layout props 
            (map (lambda (x) (markup #:addBLigs x)) strings)))
       
#(define-public (add-bligs-print grob)
  "Print function for adding Baskerville ligatures"
  (let*
      ((text (ly:grob-property grob 'text))
       (layout (ly:grob-layout grob))
       (defs (ly:output-def-lookup layout 'text-font-defaults))
       (props (ly:grob-alist-chain grob defs)))

    (ly:text-interface::interpret-markup layout
					 props
					 (if (string? text)
					     (markup #:addBLigs text)
					     text))))

#(define space-set (list->char-set (string->list ".?-;,:“”‘’–— */()[]{}|<>!`~&")))
#(define (width grob text-string)
  (let*
    ((layout (ly:grob-layout grob))
      (props (ly:grob-alist-chain grob (ly:output-def-lookup layout
        'text-font-defaults))
      )
    )
    (cdr (ly:stencil-extent (ly:text-interface::interpret-markup layout
      props (markup text-string)) X)
    )
  )
)

#(define (center-on-word grob)
  (let* (
      (text (ly:grob-property-data grob 'text))
      (syllable (if (string? text) text ""))
      (word-position (if (integer? (string-skip syllable space-set)) (string-skip syllable space-set) 0))
      (word-end (if (integer? (string-skip-right syllable space-set)) (+ (string-skip-right syllable space-set) 1) (string-length syllable)))
      (preword (substring syllable 0 word-position))
      (word (substring syllable word-position word-end ))
      (preword-width (if (string? text) (width grob preword) 0))
      (word-width (if (string? text) (width grob word) (width grob text)))
      (notehead (ly:grob-parent grob X))
      (refp (ly:grob-common-refpoint notehead grob X))
      (note-extent (ly:grob-extent notehead refp X))
      (note-width (- (cdr note-extent) (car note-extent)))
    )
    (if (= -1 (ly:grob-property-data grob 'self-alignment-X))
      (- 0 preword-width)
      (- (/ (- note-width word-width) 2) preword-width)
    )
  )
)
#(define first-stanza-number-x '())
#(define (draw-on-first-syl grob)
   (let* ((text (ly:grob-property-data grob 'text))
          (refp (ly:grob-system grob))
          ; the NoteColumn associated with our LyricText grob
          (our-note-col (ly:grob-parent (ly:grob-parent grob X) X))
          ; x offset of our note column:
          (our-note-col-x (ly:grob-relative-coordinate our-note-col refp X))
          ; This returns all grobs in a line.
          (all-grobs (ly:grob-array->list
                      (ly:grob-object refp 'all-elements)))
          ; We're only interested in NoteColumn grobs, because LyricText grobs
          ; are attached to NoteHead (whose X-parent is NoteColumn).
          (just-note-cols
            (filter
              (lambda (x) (grob::has-interface x 'note-column-interface))
              all-grobs))
          ; We want the first NoteColumn in the system.  We must locate this
          ; by position, since grobs don't seem to be listed in order in the
          ; 'all-elements grob array.  How is it possible to access _ranking_ in
          ; Scheme?  If possible, this would probably be more efficient.
          (is-first-note-col
             (fold
               (lambda (elem prev)
                 (and prev (<= our-note-col-x
                                  (ly:grob-relative-coordinate elem refp X))))
              #t
              just-note-cols))
          ; Now we need all the LyricText grobs in our notecolumn and in the first
          (all-lyric-texts
            (filter
              (lambda (x) (grob::has-interface x 'lyric-syllable-interface))
              all-grobs))
          (our-lyric-texts
            (filter
              (lambda (x) (eq? our-note-col 
                               (ly:grob-parent (ly:grob-parent x X) X)))
              all-lyric-texts))
          ; We are also interested in StanzaNumbers, if we don't yet have a
          ; value for first-stanza-number-x
          (stanza-numbers
            (filter
              (lambda (x) (grob::has-interface x 'stanza-number-interface))
              all-grobs))

          (last-lyric-text
            (fold
              (lambda (elem prev)
                elem)
              #t
              our-lyric-texts)))

     ; If our NoteColumn is the first on the line, override its stencil.
     (if (and is-first-note-col
              (> (length our-lyric-texts) 1)
              (not (eq? last-lyric-text grob))
              (or (not (null? first-stanza-number-x))
                  (> (length stanza-numbers) 0)))
         (begin
           (if (null? first-stanza-number-x)
                (set! first-stanza-number-x
                        (ly:grob-relative-coordinate
                          ; We want the first Stanza Number, similar to how
                          ; we checked if our note column was first, above
                          (fold
                            (lambda (elem prev)
                              (if (< (ly:grob-relative-coordinate elem refp X)
                                     (ly:grob-relative-coordinate prev refp X))
                                  elem
                                  prev
                              ))
                           (car stanza-numbers)
                           stanza-numbers)
                           refp X)))
            (let* ((x-offset (- (+ 1 first-stanza-number-x)
                           (ly:grob-relative-coordinate grob refp X))))
              (begin
                 (ly:grob-set-property! grob 'text
                   ;#{ \markup \combine #text \translate #'(0.0 . -0.5) \draw-line #'(4 . 0) #})
                  (markup #:combine text (#:translate (cons x-offset -0.75) (#:draw-line '(6 . 0)))))
                 (ly:grob-set-property! grob 'stencil (lyric-text::print grob))))))))